home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / edt.el < prev    next >
Text File  |  1993-07-22  |  20KB  |  486 lines
  1. ;;; edt.el --- EDT emulation in Emacs
  2.  
  3. ;; Copyright (C) 1986 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Mike Clarkson <mike@yetti.UUCP>
  6. ;; Maintainer: FSF
  7. ;; Created: 27 Aug 1986
  8. ;; Keywords: emulations
  9.  
  10. ;;  This started from public domain code by Mike Clarkson
  11. ;;  but has been greatly altered.
  12.  
  13. ;; This file is part of GNU Emacs.
  14.  
  15. ;; GNU Emacs is free software; you can redistribute it and/or modify
  16. ;; it under the terms of the GNU General Public License as published by
  17. ;; the Free Software Foundation; either version 2, or (at your option)
  18. ;; any later version.
  19.  
  20. ;; GNU Emacs is distributed in the hope that it will be useful,
  21. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. ;; GNU General Public License for more details.
  24.  
  25. ;; You should have received a copy of the GNU General Public License
  26. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  27. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28.  
  29. ;;; Commentary:
  30.  
  31. ;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation
  32. ;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson
  33. ;; at Tektronics.  This emulation was widely distributed as the file edt.ml
  34. ;; in the maclib directory of most Emacs distributions.
  35. ;;      
  36. ;; I will gladly take all criticisms and complaints to heart, and will fix what
  37. ;; bugs I can find.  As this is my first Emacs Lisp hack, you may have to root
  38. ;; out a few nasties hidden in the code.  Please let me know if you find any
  39. ;; (sorry, no rewards :-).  I would also be interested if there are better,
  40. ;; cleaner, faster ways of doing some of the things that I have done.
  41. ;;      
  42. ;; You must understand some design considerations that I had in mind.
  43. ;; The intention was not really to "emulate" EDT, but rather to take advantage
  44. ;; of the years of EDT experience that had accumulated in my right hand,
  45. ;; while at the same time taking advantage of EMACS.
  46. ;;      
  47. ;; Some major differences are:
  48. ;;      
  49. ;; HELP            is describe-key;
  50. ;; GOLD/HELP       is describe-function;
  51. ;; FIND            is isearch-forward/backward;
  52. ;; GOLD/HELP       is occur-menu, which finds all instances of a search string;
  53. ;; ENTER           is other-window;
  54. ;; SUBS            is subprocess-command.  Note that you have to change this
  55. ;;                 to `shell' if you are running Un*x;
  56. ;; PAGE            is next-paragraph, because that's more useful than page.
  57. ;; SPECINS         is copy-to-killring;
  58. ;; GOLD/GOLD       is mark-section-wisely, which is my command to mark the
  59. ;;                 section in a manner consistent with the major-mode.  It
  60. ;;                 uses mark-defun for emacs-lisp, lisp, mark-c-function for C,
  61. ;;                 and mark-paragraph for other modes.
  62. ;;      
  63. ;;      
  64. ;; Some subtle differences are:
  65. ;;      
  66. ;; APPEND          is append-to-buffer.  One doesn't append to the kill ring
  67. ;;                 much and SPECINS is now copy-to-killring;
  68. ;; REPLACE         is replace-regexp;
  69. ;; FILL            is fill-region-wisely, which uses indent-region for C, lisp
  70. ;;                 emacs-lisp, and fill-region for others. It asks if you
  71. ;;                 really want to fill-region in TeX-mode, because I find this
  72. ;;                 to be very dangerous.
  73. ;; CHNGCASE        is case-flip for the character under the cursor only.
  74. ;;                 I felt that case-flip region is unlikely, as usually you
  75. ;;                 upcase-region or downcase region.  Also, unlike EDT it
  76. ;;                 is independent of the direction you are going, as that
  77. ;;                 drives me nuts.
  78. ;;      
  79. ;; I use Emacs definition of what a word is.  This is considerably different
  80. ;; from what EDT thinks a word is.  This is not good for dyed-in-the-wool EDT
  81. ;; fans, but is probably preferable for experienced Emacs users.  My assumption
  82. ;; is that the former are a dying breed now that GNU Emacs has made it to VMS,
  83. ;; but let me know how you feel.  Also, when you undelete a word it leave the
  84. ;; point at the end of the undeleted text, rather than the beginning.  I might
  85. ;; change this as I'm not sure if I like this or not. I'm also not sure if I
  86. ;; want it to set the mark each time you delete a character or word.
  87. ;;      
  88. ;; Backspace does not invoke beginning-of-line, because ^H is the help prefix,
  89. ;; and I felt it should be left as such.  You can change this if you like.
  90. ;;      
  91. ;; The ADVANCE and BACKUP keys do not work as terminators for forward or
  92. ;; backward searches. In Emacs, all search strings are terminated by return.
  93. ;; The searches will however go forward or backward depending on your current
  94. ;; direction.  Also, when you change directions, the mode line will not be
  95. ;; updated immediately, but only when you next execute an emacs function.
  96. ;; Personally, I consider this to be a bug, not a feature.
  97. ;;      
  98. ;; This should also work with VT-2xx's, though I haven't tested it extensively
  99. ;; on those terminals.  It assumes that the CSI-map of vt_200.el has been
  100. ;; defined.
  101. ;;      
  102. ;; There are also a whole bunch of GOLD letter, and GOLD character bindings:
  103. ;; look at edtdoc.el for them, or better still, look at the edt.el lisp code,
  104. ;; because after all, in the true Lisp tradition, the source code is *assumed*
  105. ;; to be self-documenting :-)
  106. ;;      
  107. ;; Mike Clarkson,            ...!allegra \             BITNET:  mike@YUYETTI or
  108. ;; CRESS, York University,   ...!decvax   \                 SYMALG@YUSOL
  109. ;; 4700 Keele Street,        ...!ihnp4     > !utzoo!yetti!mike
  110. ;; North York, Ontario,      ...!linus    /
  111. ;; CANADA M3J 1P3.           ...!watmath /      Phone: +1 (416) 736-2100 x 7767
  112. ;;      
  113. ;; Note that I am not on ARPA, and must gateway any ARPA mail through BITNET or
  114. ;; UUCP.  If you have a UUCP or BITNET address please use it for communication
  115. ;; so that I can reach you directly.  If you have both, the BITNET address
  116. ;; is preferred.
  117.  
  118. ;;; Code:
  119.  
  120. (defvar edt-last-deleted-lines ""
  121.   "Last text deleted by an EDT emulation `line-delete' command.")
  122. (defvar edt-last-deleted-words ""
  123.   "Last text deleted by an EDT emulation `word-delete' command.")
  124. (defvar edt-last-deleted-chars ""
  125.   "Last text deleted by an EDT emulation `character-delete' command.")
  126.  
  127. (defun delete-current-line (num)
  128.   "Delete one or specified number of lines after point.
  129. This includes the newline character at the end of each line.
  130. They are saved for the EDT `undelete-lines' command."
  131.   (interactive "p")
  132.   (let ((beg (point)))
  133.     (forward-line num)
  134.     (if (not (eq (preceding-char) ?\n))
  135.     (insert "\n"))
  136.     (setq edt-last-deleted-lines
  137.       (buffer-substring beg (point)))
  138.     (delete-region beg (point))))
  139.  
  140. (defun delete-to-eol (num)
  141.   "Delete text up to end of line.
  142. With argument, delete up to to Nth line-end past point.
  143. They are saved for the EDT `undelete-lines' command."
  144.   (interactive "p")
  145.   (let ((beg (point)))
  146.     (forward-char 1)
  147.     (end-of-line num)
  148.     (setq edt-last-deleted-lines
  149.       (buffer-substring beg (point)))
  150.     (delete-region beg (point))))
  151.  
  152. (defun delete-current-word (num)
  153.   "Delete one or specified number of words after point.
  154. They are saved for the EDT `undelete-words' command."
  155.   (interactive "p")
  156.   (let ((beg (point)))
  157.     (forward-word num)
  158.     (setq edt-last-deleted-words
  159.       (buffer-substring beg (point)))
  160.     (delete-region beg (point))))
  161.  
  162. (defun edt-delete-previous-word (num)
  163.   "Delete one or specified number of words before point.
  164. They are saved for the EDT `undelete-words' command."
  165.   (interactive "p")
  166.   (let ((beg (point)))
  167.     (forward-word (- num))
  168.     (setq edt-last-deleted-words
  169.       (buffer-substring (point) beg))
  170.     (delete-region beg (point))))
  171.  
  172. (defun delete-current-char (num)
  173.   "Delete one or specified number of characters after point.
  174. They are saved for the EDT `undelete-chars' command."
  175.   (interactive "p")
  176.   (setq edt-last-deleted-chars
  177.     (buffer-substring (point) (min (point-max) (+ (point) num))))
  178.   (delete-region (point) (min (point-max) (+ (point) num))))
  179.  
  180. (defun delete-previous-char (num)
  181.   "Delete one or specified number of characters before point.
  182. They are saved for the EDT `undelete-chars' command."
  183.   (interactive "p")
  184.   (setq edt-last-deleted-chars
  185.     (buffer-substring (max (point-min) (- (point) num)) (point)))
  186.   (delete-region (max (point-min) (- (point) num)) (point)))
  187.  
  188. (defun undelete-lines ()
  189.   "Yank lines deleted by last EDT `line-delete' command."
  190.   (interactive)
  191.   (insert edt-last-deleted-lines))
  192.  
  193. (defun undelete-words ()
  194.   "Yank words deleted by last EDT `word-delete' command."
  195.   (interactive)
  196.   (insert edt-last-deleted-words))
  197.  
  198. (defun undelete-chars ()
  199.   "Yank characters deleted by last EDT `character-delete' command."
  200.   (interactive)
  201.   (insert edt-last-deleted-chars))
  202.  
  203. (defun next-end-of-line (num)
  204.   "Move to end of line; if at end, move to end of next line.
  205. Accepts a prefix argument for the number of lines to move."
  206.   (interactive "p")
  207.   (forward-char)
  208.   (end-of-line num))
  209.  
  210. (defun previous-end-of-line (num)
  211.   "Move EOL upward.
  212. Accepts a prefix argument for the number of lines to move."
  213.   (interactive "p")
  214.   (end-of-line (- 1 num)))
  215.  
  216. (defun forward-to-word (num)
  217.   "Move to next word-beginning, or to Nth following word-beginning."
  218.   (interactive "p")
  219.   (forward-word (1+ num))
  220.   (forward-word -1))
  221.  
  222. (defun backward-to-word (num)
  223.   "Move back to word-end, or to Nth word-end seen."
  224.   (interactive "p")
  225.   (forward-word (- (1+ num)))
  226.   (forward-word 1))
  227.  
  228. (defun backward-line (num)
  229.   "Move point to start of previous line.
  230. Prefix argument serves as repeat-count."
  231.   (interactive "p")
  232.   (forward-line (- num)))
  233.  
  234. (defun scroll-window-down (num)
  235.   "Scroll the display down a window-full.
  236. Accepts a prefix argument for the number of window-fulls to scroll."
  237.   (interactive "p")
  238.   (scroll-down (- (* (window-height) num) 2)))
  239.  
  240. (defun scroll-window-up (num)
  241.   "Scroll the display up a window-full.
  242. Accepts a prefix argument for the number of window-fulls to scroll."
  243.   (interactive "p")
  244.   (scroll-up (- (* (window-height) num) 2)))
  245.  
  246. (defun next-paragraph (num)
  247.   "Move to beginning of the next indented paragraph.
  248. Accepts a prefix argument for the number of paragraphs."
  249.   (interactive "p")
  250.   (while (> num 0)
  251.     (next-line 1)
  252.     (forward-paragraph)
  253.     (previous-line 1)
  254.     (if (eolp) (next-line 1))
  255.     (setq num (1- num))))
  256.  
  257. (defun previous-paragraph (num)
  258.   "Move to beginning of previous indented paragraph.
  259. Accepts a prefix argument for the number of paragraphs."
  260.   (interactive "p")
  261.   (while (> num 0)
  262.     (backward-paragraph)
  263.     (previous-line 1)
  264.     (if (eolp) (next-line 1))
  265.     (setq num (1- num))))
  266.  
  267. (defun move-to-beginning ()
  268.   "Move cursor to the beginning of buffer, but don't set the mark."
  269.   (interactive)
  270.   (goto-char (point-min)))
  271.  
  272. (defun move-to-end ()
  273.   "Move cursor to the end of buffer, but don't set the mark."
  274.   (interactive)
  275.   (goto-char (point-max)))
  276.  
  277. (defun goto-percent (perc)
  278.   "Move point to ARG percentage of the buffer."
  279.   (interactive "NGoto-percentage: ")
  280.   (if (or (> perc 100) (< perc 0))
  281.       (error "Percentage %d out of range 0 < percent < 100" perc)
  282.     (goto-char (/ (* (point-max) perc) 100))))
  283.  
  284. (defun update-mode-line ()
  285.   "Ensure mode-line reflects all changes."
  286.   (set-buffer-modified-p (buffer-modified-p))
  287.   (sit-for 0))
  288.  
  289. (defun advance-direction ()
  290.   "Set EDT Advance mode so keypad commands move forward."
  291.   (interactive)
  292.   (setq edt-direction-string " ADVANCE")
  293.   (global-set-key [kp-f3] 'isearch-forward)
  294.   (global-set-key [kp-8] 'scroll-window-up)
  295.   (global-set-key [kp-7] 'next-paragraph)
  296.   (global-set-key [kp-1] 'forward-to-word)
  297.   (global-set-key [kp-2] 'next-end-of-line)
  298.   (global-set-key [kp-3] 'forward-char)
  299.   (global-set-key [kp-0] 'forward-line)
  300.   (update-mode-line))
  301.  
  302. (defun backup-direction ()
  303.   "Set EDT Backup mode so keypad commands move backward."
  304.   (interactive)
  305.   (setq edt-direction-string " BACKUP")
  306.   (global-set-key [kp-f3] 'isearch-backward)
  307.   (global-set-key [kp-8] 'scroll-window-down)
  308.   (global-set-key [kp-7] 'previous-paragraph)
  309.   (global-set-key [kp-1] 'backward-to-word)
  310.   (global-set-key [kp-2] 'previous-end-of-line)
  311.   (global-set-key [kp-3] 'backward-char)
  312.   (global-set-key [kp-9] 'backward-line)
  313.   (update-mode-line))
  314.  
  315. (defun edt-beginning-of-window ()
  316.   "Home cursor to top of window."
  317.   (interactive)
  318.   (move-to-window-line 0))
  319.  
  320. (defun edt-line-to-bottom-of-window ()
  321.   "Move the current line to the top of the window."
  322.   (interactive)
  323.   (recenter -1))
  324.  
  325. (defun edt-line-to-top-of-window ()
  326.   "Move the current line to the top of the window."
  327.   (interactive)
  328.   (recenter 0))
  329.  
  330. (defun case-flip-character (num)
  331.   "Change the case of the character under the cursor.
  332. Accepts a prefix argument of the number of characters to invert."
  333.   (interactive "p")
  334.   (while (> num 0)
  335.     (funcall (if (<= ?a (following-char))
  336.          'upcase-region 'downcase-region)
  337.          (point) (1+ (point)))
  338.     (forward-char 1)
  339.     (setq num (1- num))))
  340.  
  341. (defun indent-or-fill-region ()
  342.   "Fill region in text modes, indent region in programming language modes."
  343.   (interactive)
  344.   (if (string= paragraph-start "^$\\|^ ")
  345.       (indent-region (point) (mark) nil)
  346.     (fill-region (point) (mark))))
  347.  
  348. (defun mark-section-wisely ()
  349.   "Mark the section in a manner consistent with the major-mode.
  350. Uses mark-defun for emacs-lisp, lisp,
  351. mark-c-function for C,
  352. and mark-paragraph for other modes."
  353.   (interactive)
  354.   (cond  ((eq major-mode 'emacs-lisp-mode)
  355.       (mark-defun))
  356.      ((eq major-mode 'lisp-mode)
  357.       (mark-defun))
  358.      ((eq major-mode 'c-mode)
  359.       (mark-c-function))
  360.      (t (mark-paragraph))))
  361.  
  362. ;;; Key Bindings
  363. ;;;###autoload
  364. (defun edt-emulation-on ()
  365.   "Emulate DEC's EDT editor.
  366. Note that many keys are rebound; including nearly all keypad keys.
  367. Use \\[edt-emulation-off] to undo all rebindings except the keypad keys."
  368.   (interactive)
  369.   (advance-direction)
  370.   (edt-bind-gold-keypad)
  371.   (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
  372.   (global-set-key "\C-\\" 'quoted-insert)
  373.   (setq edt-mode-old-delete (lookup-key global-map "\177"))
  374.   (global-set-key "\177" 'delete-previous-char)      ;"Delete"
  375.   (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
  376.   (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
  377.   (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
  378.   (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
  379.   (global-set-key "\C-j" 'edt-delete-previous-word)           ;"LineFeed"
  380.   (define-key esc-map "?" 'apropos))                      ;"<ESC>?"
  381.  
  382. (defun edt-emulation-off ()
  383.   "Return from EDT emulation to normal Emacs key bindings.
  384. The keys redefined by \\[edt-emulation-on] are given their old definitions."
  385.   (interactive)
  386.   (setq edt-direction-string nil)
  387.   (global-set-key "\C-\\" edt-mode-old-c-\\)
  388.   (global-set-key "\177" edt-mode-old-delete)        ;"Delete"
  389.   (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
  390.   (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
  391.   (global-set-key "\C-j" edt-mode-old-linefeed))           ;"LineFeed"
  392.  
  393. (defvar GOLD-map (make-keymap)
  394.    "`GOLD-map' maps the function keys on the VT100 keyboard preceded
  395. by the PF1 key.  GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
  396.  
  397. (defalias 'GOLD-prefix GOLD-map)
  398.  
  399. (global-set-key [home] 'edt-beginning-of-window)
  400. (global-set-key [kp-f2] 'describe-key)
  401. (global-set-key [kp-f4] 'delete-current-line)
  402. (global-set-key [kp-9] 'append-to-buffer)
  403. (global-set-key [kp-subtract] 'delete-current-word)
  404. (global-set-key [kp-4] 'advance-direction)
  405. (global-set-key [kp-5] 'backup-direction)
  406. (global-set-key [kp-6] 'kill-region)
  407. (global-set-key [kp-separator] 'delete-current-char)
  408. (global-set-key [kp-decimal] 'set-mark-command)
  409. (global-set-key [kp-enter] 'other-window)
  410. (global-set-key [kp-f1] 'GOLD-prefix)
  411.  
  412. ;;Bind GOLD/Keyboard keys
  413.  
  414. (define-key GOLD-map "\C-g"  'keyboard-quit)            ; just for safety
  415. (define-key GOLD-map "\177" 'delete-window)             ;"Delete"
  416. (define-key GOLD-map "\C-h" 'delete-other-windows)      ;"BackSpace"
  417. (define-key GOLD-map "\C-m" 'newline-and-indent)        ;"Return"
  418. (define-key GOLD-map " " 'undo)                ;"Spacebar"
  419. (define-key GOLD-map "%" 'goto-percent)                 ; "%"
  420. (define-key GOLD-map "=" 'goto-line)                    ; "="
  421. (define-key GOLD-map "`" 'what-line)                    ; "`"
  422. (define-key GOLD-map "\C-\\" 'split-window-vertically)  ; "Control-\"
  423.  
  424. ; GOLD letter combinations:
  425. (define-key GOLD-map "b" 'buffer-menu)                  ; "b"
  426. (define-key GOLD-map "B" 'buffer-menu)                  ; "B"
  427. (define-key GOLD-map "d" 'delete-window)                ; "d"
  428. (define-key GOLD-map "D" 'delete-window)                ; "D"
  429. (define-key GOLD-map "e" 'compile)                      ; "e"
  430. (define-key GOLD-map "E" 'compile)                      ; "E"
  431. (define-key GOLD-map "i" 'insert-file)                  ; "i"
  432. (define-key GOLD-map "I" 'insert-file)                  ; "I"
  433. (define-key GOLD-map "l" 'goto-line)                    ; "l"
  434. (define-key GOLD-map "L" 'goto-line)                    ; "L"
  435. (define-key GOLD-map "m" 'save-some-buffers)        ; "m"
  436. (define-key GOLD-map "M" 'save-some-buffers)        ; "m"
  437. (define-key GOLD-map "n" 'next-error)                           ; "n"
  438. (define-key GOLD-map "N" 'next-error)                           ; "N"
  439. (define-key GOLD-map "o" 'switch-to-buffer-other-window)        ; "o"
  440. (define-key GOLD-map "O" 'switch-to-buffer-other-window)        ; "O"
  441. (define-key GOLD-map "r" 'revert-file)                          ; "r"
  442. (define-key GOLD-map "r" 'revert-file)                          ; "R"
  443. (define-key GOLD-map "s" 'save-buffer)                          ; "s"
  444. (define-key GOLD-map "S" 'save-buffer)                          ; "S"
  445. (define-key GOLD-map "v" 'find-file-other-window)               ; "v"
  446. (define-key GOLD-map "V" 'find-file-other-window)               ; "V"
  447. (define-key GOLD-map "w" 'write-file)                           ; "w"
  448. (define-key GOLD-map "w" 'write-file)                           ; "W"
  449. ;(define-key GOLD-map "z" 'shrink-window)                 ; "z"
  450. ;(define-key GOLD-map "Z" 'shrink-window)                 ; "z"
  451.  
  452. ;Bind GOLD/Keypad keys
  453. (defun edt-bind-gold-keypad ()
  454.   (define-key GOLD-map [up] 'edt-line-to-top-of-window)
  455.   (define-key GOLD-map [down] 'edt-line-to-bottom-of-window)
  456.   (define-key GOLD-map [left] 'backward-sentence)
  457.   (define-key GOLD-map [right] 'forward-sentence)
  458.   (define-key GOLD-map [kp-f1] 'mark-section-wisely)
  459.   (define-key GOLD-map [kp-f2] 'describe-function)
  460.   (define-key GOLD-map [kp-f3] 'occur)
  461.   (define-key GOLD-map [kp-f4] 'undelete-lines)
  462.   (define-key GOLD-map [kp-0] 'open-line)
  463.   (define-key GOLD-map [kp-1] 'case-flip-character)
  464.   (define-key GOLD-map [kp-2] 'delete-to-eol)
  465.   (define-key GOLD-map [kp-3] 'copy-region-as-kill)
  466.   (define-key GOLD-map [kp-4] 'move-to-end)
  467.   (define-key GOLD-map [kp-5] 'move-to-beginning)
  468.   (define-key GOLD-map [kp-6] 'yank)
  469.   (define-key GOLD-map [kp-7] 'execute-extended-command)
  470.   (define-key GOLD-map [kp-8] 'indent-or-fill-region)
  471.   (define-key GOLD-map [kp-9] 'replace-regexp)
  472.   (define-key GOLD-map [kp-subtract] 'undelete-words)
  473.   (define-key GOLD-map [kp-separator] 'undelete-chars)
  474.   (define-key GOLD-map [kp-decimal] 'redraw-display)
  475.   (define-key GOLD-map [kp-enter] 'shell-command))
  476.  
  477. ;; Make direction of motion show in mode line
  478. ;; while EDT emulation is turned on.
  479. ;; Note that the keypad is always turned on when in Emacs.
  480.  
  481. (or (assq 'edt-direction-string minor-mode-alist)
  482.     (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
  483.                  minor-mode-alist)))
  484.  
  485. ;;; edt.el ends here
  486.